Developer CD Series 1994 August: Tool Chest/Dev.CD Aug 94.toast/Tool Chest/Networking & Communications/MacTCP/MacTCP Developer Tools/HyperCard MacTCP Toolkit 1.0/Source Code ƒ/TCPRecvUpTo.p

Text File | 1993-06-15 | 5.6 KB | 195 lines | [TEXT/MPS ]

(*
    TCPRecvUpTo(connectionID,termination character, waitTime,oldString) -- Return a string from the
        TCP connection; return everything available, up to the termination character (if any). Pass an empty
        termination character to receive everything available. WaitTime is the amount of time to wait
        for the input, in ticks (60ths of a second). oldString is what was read the last call (presumably
        terminated due to a time-out).

    To compile and link this file using Macintosh Programmer's Workshop,

        pascal -w TCPRecvUpTo.p
        link -m ENTRYPOINT -o HyperCommands -rt XFCN=7864 -sn Main=TCPRecvUpTo ∂
            TCPRecvUpTo.p.o "{Libraries}HyperXLib.o" "{MPW}"Libraries:interface.o

    © Copyright 1988 by Apple Computer, Inc.

    Initial coding 12/88 by Harry R. Chesley.
*)

{$R-}

{$S TCPRecvUpTo }     { Segment name must be the same as the command name. }

unit DummyUnit;

interface

uses MemTypes, QuickDraw, OSIntf, ToolIntf, HyperXCmd;

procedure EntryPoint(paramPtr: XCmdPtr);

implementation

procedure TCPRecvUpTo(paramPtr: XCmdPtr); forward;

procedure EntryPoint(paramPtr: XCmdPtr);

    begin
        TCPRecvUpTo(paramPtr);
    end;

procedure TCPRecvUpTo(paramPtr: XCmdPtr);

    var str: Str255;
        waitForChars: longInt;        { Ticks to wait until for characters (compated to TickCount). }
        lookForTerm: boolean;        { True if we're looking for a terminator character. }
        termChar: SignedByte;        { The terminator character we're looking for. }
        resultHand: Handle;            { A handle to the result string. }
        resultSize: longInt;            { The size of the result string (minus the zero termination tacked on last). }
        inChar: SignedByte;
        p: Ptr;

    procedure Fail(errMsg: Str255); { set theResult and quit }
        begin
            paramPtr^.returnValue := PasToZero(paramPtr,errMsg);
            exit(TCPRecvUpTo);
        end;

    {$I TCPUtil.inc}

    procedure disposAndFail(err: str255);
        { Fail routine used after the result handle has been allocated. }

        begin
            DisposHandle(resultHand);
            Fail(err);
        end;

    procedure putByte(b: SignedByte);
        { Put the byte b after the output handle, increasing the handle's size in the process. }

        var p: Ptr;

        begin
            resultSize := resultSize+1;
            SetHandleSize(resultHand,resultSize);
            if MemError <> noErr then disposAndFail('§§§ SetHandleSize failed §§§');
            p := Ptr(ord4(resultHand^)+resultSize-1);
            p^ := b;
        end;

    function nextByte: SignedByte;
        { Return the next byte in the buffer, reading more in if necessary. }

        var waitUntil: longInt;
            readIn: longInt;

        begin
            with Connection^ do
                begin
                    { Check if we need to read in more bytes. }
                    if incomingSize = 0 then
                        begin
                            { If yes, then keep on trying to read until we get at least one, or the time-out happens. }
                            waitUntil := TickCount + waitForChars;
                            while true do
                                begin
                                    { Get the status. }
                                    ZeroIOParms;
                                    SyncControlBlock.csCode := TCPcsStatus;
                                    if PBControl(@SyncControlBlock,false) <> noErr then
                                        disposAndFail('§§§ TCP status failed §§§');
                                    readIn := ControlWordAtOffset(60);
                                    { If there's something there to read, do so. }
                                    if readIn > 0 then
                                        begin
                                            { Don't read any more than will fit in the buffer. }
                                            if readIn > INCOMINGBUFSIZE then readIn := INCOMINGBUFSIZE;
                                            { Issue the read. }
                                            ZeroIOParms;
                                            SyncControlBlock.csCode := TCPcsRcv;
                                            PutControlLongAtOffset(ord4(@inBuf),36);
                                            PutControlWordAtOffset(readIn,40);
                                            if PBControl(@SyncControlBlock,false) <> noErr then
                                                disposAndFail('§§§ TCP read failed §§§');
                                            incomingSize := readIn;
                                            incomingPtr := @inBuf;
                                            leave;
                                        end
                                    { If not, do another round or get out, depending on the timeout condition. }
                                    else if TickCount > waitUntil then
                                        begin
                                            putByte(0);
                                            paramPtr^.returnValue := resultHand;
                                            exit(TCPRecvUpTo);
                                        end;
                                end;
                        end;
                    { Get the byte to return. }
                    nextByte := incomingPtr^;
                    incomingPtr := Ptr(ord4(incomingPtr)+1);
                    incomingSize := incomingSize-1;
                end;
        end;

    begin
        if paramPtr^.paramCount <> 4 then Fail('§§§ parameter count is not 4 §§§');

        SetUpConnectionID;

        GetStrParm(2,str);                                        { First parameter is termination character. }
        if length(str) = 0 then lookForTerm := false
        else
            begin
                lookForTerm := true;
                termChar := ord(str[1]);
            end;
        waitForChars := GetLongParm(3);                    { Second parameter is whether to wait. }
        resultHand := paramPtr^.params[4];                { Third parameter is the old string. }

        { If there's anything in the "previous" string, copy it. }
        if resultHand <> NIL then
            begin
                p := resultHand^;
                resultSize := 0;
                while p^ <> 0 do
                    begin
                        resultSize := resultSize + 1;
                        p := Ptr(ord4(p)+1);
                    end;
                if resultSize < 0 then Fail('§§§ Input string size too small §§§');
                if HandToHand(resultHand) <> noErr then Fail('§§§ HandToHand failed §§§');
                SetHandleSize(resultHand,resultSize);
            end
        { On the other hand, if the previous string is empty, make a new, empty one. }
        else
            begin
                resultHand := NewHandle(0);
                resultSize := 0;
            end;

        { Cycle until the timeout happens or we see the termintor character. }
        while true do
            begin
                { Get the next character. }
                inChar := nextByte;
                { Ignore the character if it's a zero. }
                if inChar <> 0 then
                    begin
                        { Put it in the result. }
                        putByte(inChar);
                        { Check for the end. }
                        if lookForTerm then
                            if inChar = termChar then leave;
                    end;
            end;

        { Add in the zero termination for the string. }
        putByte(0);

        { Return the handle. }
        paramPtr^.returnValue := resultHand;
    end;

end.